home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 011-020 / amok16 / memsystem / errorreq.mod < prev    next >
Text File  |  1993-11-04  |  2KB  |  82 lines
  1. (**********************************************************************
  2.  
  3.     :Program.    ErrorReq.mod
  4.     :Contents.   Requesters or Messages to handle Errors, Warnings...
  5.     :Author.     Nicolas Benezan [bne]
  6.     :Address.    Postwiesenstr. 2, D7000 Stuttgart 60
  7.     :Phone.      711/333679
  8.     :Copyright.  Public Domain
  9.     :Language.   Modula-2
  10.     :Translator. M2Amiga AMSoft 3.2d
  11.     :History.    V1.0b [bne] 27.Jan.1989 (extracted from MemSystem1.1)
  12.     :History.    V1.1a [bne] 27.Jan.1989 (YesNoReq. modified, m2cV3.2)
  13.     :History.    V1.2b [bne] 12.Feb.1989 (+ Assert)
  14.     :History.    V1.3a [bne] 22.Mar.1989 (bug fixed)
  15.  
  16. **********************************************************************)
  17.  
  18. IMPLEMENTATION MODULE ErrorReq;
  19.  
  20. FROM SYSTEM     IMPORT ADDRESS, ADR;
  21. FROM Arts       IMPORT Terminate, CurrentLevel, Requester, wbStarted;
  22. FROM Dos        IMPORT Write, Output;
  23. FROM Str        IMPORT Length, Concat, Copy;
  24. IMPORT ASCII;
  25.  
  26. CONST   ReqWidth=320;
  27.         ReqHeight=72;
  28. VAR     LineFeed:ARRAY [0..0] OF CHAR;
  29.  
  30. PROCEDURE YesNoRequest(BodyText,PositiveText,NegativeText:ADDRESS):BOOLEAN;
  31. BEGIN
  32.   RETURN Requester(ADR(ErrHeader),BodyText,PositiveText,NegativeText);
  33. END YesNoRequest;
  34.  
  35. PROCEDURE RecoverableExit(ReqBody,PosText,NegText:ADDRESS);
  36. BEGIN
  37.   IF NOT YesNoRequest(ReqBody,PosText,NegText) THEN
  38.     ExitQuiet;
  39.   END;
  40. END RecoverableExit;
  41.  
  42. PROCEDURE DeadEndExit(ReqBody:ADDRESS);
  43. VAR     Dummy:BOOLEAN;
  44. BEGIN
  45.   Dummy:=YesNoRequest(ReqBody,NIL,ADR(ABORT));
  46.   ExitQuiet;
  47. END DeadEndExit;
  48.  
  49. (*­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­*)
  50. (* Assert CLI: writes message to current window WB: Requester           *)
  51. (*­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­*)
  52. PROCEDURE Assert(Condition:BOOLEAN;Text:ADDRESS);
  53. TYPE    String=ARRAY [0..80] OF CHAR;
  54. VAR     Dummy:LONGINT;
  55.         TextPtr:POINTER TO String;
  56.         Line:String;
  57. BEGIN
  58.   IF NOT Condition THEN
  59.     IF wbStarted THEN
  60.       DeadEndExit(Text);
  61.     ELSE
  62.       TextPtr:=Text;
  63.       Copy(Line,AssertMessage);
  64.       Concat(Line,TextPtr^);
  65.       Concat(Line,LineFeed);
  66.       Dummy:=Write(Output(),ADR(Line),Length(Line));
  67.       ExitQuiet;
  68.     END;
  69.   END;
  70. END Assert;
  71.  
  72. PROCEDURE ExitQuiet;
  73. BEGIN
  74.   Terminate(CurrentLevel());
  75. END ExitQuiet;
  76.  
  77. BEGIN
  78.   ErrHeader:="Modula-2 Error Handler";
  79.   AssertMessage:="Break (Assert): ";
  80.   LineFeed:=ASCII.lf;
  81. END ErrorReq.
  82.